home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvg110a.zip / T6DEMSRC.ZIP / TVDEMO.PAS < prev   
Pascal/Delphi Source File  |  1993-02-22  |  18KB  |  640 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Demo                            }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program TVDemo;
  10.  
  11. {$X+,S-}
  12. {$M 16384,8192,655360}
  13.  
  14. { Turbo Vision demo program. This program uses many of the Turbo
  15.   Vision standard and demo units, including:
  16.  
  17.     StdDlg    - Open file browser, change directory tree.
  18.     MsgBox    - Simple dialog to display messages.
  19.     ColorSel  - Color customization.
  20.     Gadgets   - Shows system time and available heap space.
  21.     AsciiTab  - ASCII table.
  22.     Calendar  - View a month at a time
  23.     Calc      - Desktop calculator.
  24.     FViewer   - Scroll through text files.
  25.     HelpFile  - Context sensitive help.
  26.     MouseDlg  - Mouse options dialog.
  27.     Puzzle    - Simple brain puzzle.
  28.  
  29.   And of course this program includes many standard Turbo Vision
  30.   objects and behaviors (menubar, desktop, status line, dialog boxes,
  31.   mouse support, window resize/move/tile/cascade).
  32. }
  33.  
  34. uses
  35.   TVGraph, TVGDefs, TVGWhiz, Styx,                    (*** TVGRAPH ***)
  36.   Dos, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg, MsgBox, App,
  37.   DemoCmds, Gadgets, Puzzle, Calendar, AsciiTab, Calc, FViewer, HelpFile,
  38.   DemoHelp, ColorSel, MouseDlg;
  39.  
  40. type
  41.  
  42.   { TTVDemo }
  43.  
  44.   PTVDemo = ^TTVDemo;
  45.   TTVDemo = object(TVGApp)                            (*** TVGRAPH ***)
  46.     Clock: PClockView;
  47.     Heap: PHeapView;
  48.     constructor Init;
  49.     procedure FileOpen(WildCard: PathStr);
  50.     procedure GetEvent(var Event: TEvent); virtual;
  51.     function GetPalette: PPalette; virtual;
  52.     procedure HandleEvent(var Event: TEvent); virtual;
  53.     procedure Idle; virtual;
  54.     procedure InitMenuBar; virtual;
  55.     procedure InitStatusLine; virtual;
  56.     procedure LoadDesktop(var S: TStream);
  57.     procedure OutOfMemory; virtual;
  58.     procedure StoreDesktop(var S: TStream);
  59.     procedure ViewFile(FileName: PathStr);
  60.   end;
  61.  
  62. { CalcHelpName }
  63.  
  64. function CalcHelpName: PathStr;
  65. var
  66.   EXEName: PathStr;
  67.   Dir: DirStr;
  68.   Name: NameStr;
  69.   Ext: ExtStr;
  70. begin
  71.   if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
  72.   else EXEName := FSearch('TVDEMO.EXE', GetEnv('PATH'));
  73.   FSplit(EXEName, Dir, Name, Ext);
  74.   if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  75.   CalcHelpName := FSearch('DEMOHELP.HLP', Dir);
  76. end;
  77.  
  78.  
  79. { TTVDemo }
  80. constructor TTVDemo.Init;
  81. var
  82.   R: TRect;
  83.   I: Integer;
  84.   FileName: PathStr;
  85. begin
  86.   BGIPath:='D:\BP\UNITS6';                      (*** TVGRAPH ***)
  87.   TVGApp.Init;                                  (*** TVGRAPH ***)
  88.   ShadowSize.X:=0;
  89.   ShadowSize.Y:=0;
  90.   RegisterObjects;
  91.   RegisterViews;
  92.   RegisterMenus;
  93.   RegisterDialogs;
  94.   RegisterApp;
  95.   RegisterHelpFile;
  96.   RegisterPuzzle;
  97.   RegisterCalendar;
  98.   RegisterAsciiTab;
  99.   RegisterCalc;
  100.   RegisterFViewer;
  101.   RegisterStyx;                                 (*** TVGRAPH ***)
  102.  
  103.   GetExtent(R);
  104.   R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  105.   Clock := New(PClockView, Init(R));
  106.   Insert(Clock);
  107.  
  108.   GetExtent(R);
  109.   Dec(R.B.X);
  110.   R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  111.   Heap := New(PHeapView, Init(R));
  112.   Insert(Heap);
  113.  
  114.   for I := 1 to ParamCount do
  115.   begin
  116.     FileName := ParamStr(I);
  117.     if FileName[Length(FileName)] = '\' then
  118.       FileName := FileName + '*.*';
  119.     if (Pos('?', FileName) = 0) and (Pos('*', FileName) = 0) then
  120.       ViewFile(FExpand(FileName))
  121.     else FileOpen(FileName);
  122.   end;
  123.  
  124. end;
  125.  
  126. procedure TTVDemo.FileOpen(WildCard: PathStr);
  127. var
  128.   D: PFileDialog;
  129.   FileName: PathStr;
  130. begin
  131.   D := New(PFileDialog, Init(WildCard, 'Open a File',
  132.     '~N~ame', fdOpenButton + fdHelpButton, 100));
  133.   D^.HelpCtx := hcFOFileOpenDBox;
  134.   if ValidView(D) <> nil then
  135.   begin
  136.     if Desktop^.ExecView(D) <> cmCancel then
  137.     begin
  138.       D^.GetFileName(FileName);
  139.       ViewFile(FileName);
  140.     end;
  141.     Dispose(D, Done);
  142.   end;
  143. end;
  144.  
  145. procedure TTVDemo.GetEvent(var Event: TEvent);
  146. var
  147.   W: PWindow;
  148.   HFile: PHelpFile;
  149.   HelpStrm: PDosStream;
  150. const
  151.   HelpInUse: Boolean = False;
  152. begin
  153.   TVGApp.GetEvent(Event);                               (*** TVGRAPH ***)
  154.   case Event.What of
  155.     evCommand:
  156.       if (Event.Command = cmHelp) and not HelpInUse then
  157.       begin
  158.         HelpInUse := True;
  159.         HelpStrm := New(PDosStream, Init(CalcHelpName, stOpenRead));
  160.         HFile := New(PHelpFile, Init(HelpStrm));
  161.         if HelpStrm^.Status <> stOk then
  162.         begin
  163.           MessageBox('Could not open help file.', nil, mfError + mfOkButton);
  164.           Dispose(HFile, Done);
  165.         end
  166.         else
  167.         begin
  168.           W := New(PHelpWindow,Init(HFile, GetHelpCtx));
  169.           if ValidView(W) <> nil then
  170.           begin
  171.             ExecView(W);
  172.             Dispose(W, Done);
  173.           end;
  174.           ClearEvent(Event);
  175.         end;
  176.         HelpInUse := False;
  177.       end;
  178.     evMouseDown:
  179.       if Event.Buttons <> 1 then Event.What := evNothing;
  180.   end;
  181. end;
  182.  
  183. function TTVDemo.GetPalette: PPalette;
  184. const
  185.   CNewColor = CColor + CHelpColor;
  186.   CNewBlackWhite = CBlackWhite + CHelpBlackWhite;
  187.   CNewMonochrome = CMonochrome + CHelpMonochrome;
  188.   P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
  189.     (CNewColor, CNewBlackWhite, CNewMonochrome);
  190. begin
  191.   GetPalette := @P[AppPalette];
  192. end;
  193.  
  194. procedure TTVDemo.HandleEvent(var Event: TEvent);
  195.  
  196. procedure ChangeDir;
  197. var
  198.   D: PChDirDialog;
  199. begin
  200.   D := New(PChDirDialog, Init(cdNormal + cdHelpButton, 101));
  201.   D^.HelpCtx := hcFCChDirDBox;
  202.   if ValidView(D) <> nil then
  203.   begin
  204.     DeskTop^.ExecView(D);
  205.     Dispose(D, Done);
  206.   end;
  207. end;
  208.  
  209. procedure Tile;
  210. var
  211.   R: TRect;
  212. begin
  213.   Desktop^.GetExtent(R);
  214.   Desktop^.Tile(R);
  215. end;
  216.  
  217. procedure Cascade;
  218. var
  219.   R: TRect;
  220. begin
  221.   Desktop^.GetExtent(R);
  222.   Desktop^.Cascade(R);
  223. end;
  224.  
  225. procedure Puzzle;
  226. var
  227.   P: PPuzzleWindow;
  228. begin
  229.   P := New(PPuzzleWindow, Init);
  230.   P^.HelpCtx := hcPuzzle;
  231.   Desktop^.Insert(ValidView(P));
  232. end;
  233.  
  234. procedure Calendar;
  235. var
  236.   P: PCalendarWindow;
  237. begin
  238.   P := New(PCalendarWindow, Init);
  239.   P^.HelpCtx := hcCalendar;
  240.   Desktop^.Insert(ValidView(P));
  241. end;
  242.  
  243. procedure About;
  244. var
  245.   D: PDialog;
  246.   Control: PView;
  247.   R: TRect;
  248. begin
  249.   R.Assign(0, 0, 40, 11);
  250.   D := New(PDialog, Init(R, 'About'));
  251.   with D^ do
  252.   begin
  253.     Options := Options or ofCentered;
  254.  
  255.     R.Grow(-1, -1);
  256.     Dec(R.B.Y, 3);
  257.     Insert(New(PStaticText, Init(R,
  258.       #13 +
  259.       ^C'Turbo Vision Demo'#13 +
  260.       #13 +
  261.       ^C'Copyright (c) 1990'#13 +
  262.       #13 +
  263.       ^C'Borland International')));
  264.  
  265.     R.Assign(15, 8, 25, 10);
  266.     Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  267.   end;
  268.   if ValidView(D) <> nil then
  269.   begin
  270.     Desktop^.ExecView(D);
  271.     Dispose(D, Done);
  272.   end;
  273. end;
  274.  
  275. procedure AsciiTab;
  276. var
  277.   P: PAsciiChart;
  278. begin
  279.   P := New(PAsciiChart, Init);
  280.   P^.HelpCtx := hcAsciiTable;
  281.   Desktop^.Insert(ValidView(P));
  282. end;
  283.  
  284. procedure OpenStyx;                                        (*** TVGRAPH ***)
  285. var                                                        (*** TVGRAPH ***)
  286.   P: PStyxDemo;                                            (*** TVGRAPH ***)
  287. begin                                                      (*** TVGRAPH ***)
  288.   P := New(PStyxDemo, Init);                               (*** TVGRAPH ***)
  289.   P^.HelpCtx := hcNoContext;                               (*** TVGRAPH ***)
  290.   Desktop^.Insert(ValidView(P));                           (*** TVGRAPH ***)
  291. end;                                                       (*** TVGRAPH ***)
  292.  
  293. procedure Calculator;
  294. var
  295.   P: PCalculator;
  296. begin
  297.   P := New(PCalculator, Init);
  298.   P^.HelpCtx := hcCalculator;
  299.   if ValidView(P) <> nil then
  300.     Desktop^.Insert(P);
  301. end;
  302.  
  303. procedure Colors;
  304. var
  305.   D: PColorDialog;
  306. begin
  307.   D := New(PColorDialog, Init('',
  308.     ColorGroup('Desktop',
  309.       ColorItem('Color',             32, nil),
  310.     ColorGroup('Menus',
  311.       ColorItem('Normal',            2,
  312.       ColorItem('Disabled